home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / teglp.zip / SAMPROGS.ZIP / CTEST02.PAS < prev    next >
Pascal/Delphi Source File  |  1990-06-29  |  4KB  |  140 lines
  1.  
  2. USES
  3.     crt,
  4.     graph,
  5.     TEGLfont,
  6.     TEGLIntr,
  7.     FastGrph;
  8.  
  9. const
  10.   TEGLBackPattern    : FillPatternType = ($AA,$55,$AA,$55,$AA,$55,$AA,$55);
  11.  
  12. var
  13.   ch : char;
  14.   i  : word;
  15.  
  16. procedure waitforkey;
  17.    begin
  18.       while keypressed do ch:=readkey;
  19.       while not keypressed do;
  20.       while keypressed do ch:=readkey;
  21.    end;
  22.  
  23. procedure hpixline(x,y,x1,c:word);
  24.    var i:word;
  25.    begin
  26.       for i:=x to x1 do
  27.      putpixs(i,y,c);
  28.    end;
  29.  
  30. procedure vpixline(x,y,y1,c:word);
  31.    var i:word;
  32.    begin
  33.       for i:=y to y1 do
  34.      putpixs(x,i,c);
  35.    end;
  36.  
  37. procedure TestAllLines(x,y:word; msg:string; rmw,color:word);
  38.    var mx,my,x1,y1 : word;
  39.    begin
  40.       RmwBits := FGNorm;
  41.       fonttable := @font09;
  42.       setcolor(white);
  43.       outtegltextxy(x,y,msg);
  44.  
  45.       RmwBits := rmw;
  46.       inc(y,10);
  47.       mx := 40;
  48.       my := 40;
  49.       x1 := x+80;
  50.       y1 := y+80;
  51.  
  52.       setfillstyle(solidfill,white);
  53.       bar(x,y,x1,y1);
  54.       setfillstyle(solidfill,black);
  55.       bar(x+10,y+10,x1-10,y1-10);
  56.  
  57.       fastline(x,y+my,x+mx,y+my,color);         {horizontal line}
  58.       fastline(x+mx,y,x+mx,y+my,color);         {vertical line}
  59.  
  60.       hpixline(x+mx,y+my,x1,color);            {horizontal line}
  61.       vpixline(x+mx,y+my,y1,color);            {vertical line}
  62.  
  63.  
  64.  
  65.       fastline(x,y,x1,y1,color);            {slope line}
  66.       fastline(x,y1,x1,y,color);            {slope line}
  67.  
  68.       fastline(x,y+(my div 2),x+mx,y+my,color);     {slope line}
  69.       fastline(x1,y+(my div 2),x+mx,y+my,color);    {slope line}
  70.       fastline(x,y+my+(my div 2),x+mx,y+my,color);    {slope line}
  71.       fastline(x1,y+my+(my div 2),x+mx,y+my,color);    {slope line}
  72.  
  73.       fastline(x+(mx div 2),y,x+mx,y+my,color);     {slope line}
  74.       fastline(x+mx+(mx div 2),y,x+mx,y+my,color);    {slope line}
  75.       fastline(x+(mx div 2),y1,x+mx,y+my,color);    {slope line}
  76.       fastline(x+mx+(mx div 2),y1,x+mx,y+my,color);    {slope line}
  77.    end;
  78.  
  79. procedure testchars(x,y,color,rmw:word; msg:string);
  80.    begin
  81.       RmwBits := fgnorm;
  82.       setcolor(white);
  83.       fonttable := @font09;
  84.       outtegltextxy(0,y,msg);
  85.  
  86.       fonttable := @font14;
  87.       RmwBits := rmw;
  88.       setcolor(color);
  89.       setfillstyle(solidfill,white);
  90.       bar(x+((getmaxx-x) div 2),y,getmaxx,y+teglcharheight);
  91.       outtegltextxy(x,y,'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890');
  92.    end;
  93.  
  94. begin
  95.    CGA640x200x2;
  96.    Init_TEGLIntr;
  97.    setmouseminmax(0,0,getmaxx,getmaxy);
  98.  
  99.    TestAllLines(10,0,'FGNORM',FGNorm,white);
  100.    TestAllLines(10,100,'FGNORM',FGNorm,black);
  101.  
  102.    TestAllLines(100,0,'FGNOT',FGNot,white);
  103.    TestAllLines(100,100,'FGNOT',FGNot,black);
  104.  
  105.    TestAllLines(200,0,'FGAND',FGAnd,white);
  106.    TestAllLines(200,100,'FGAND',FGAnd,black);
  107.  
  108.    TestAllLines(300,0,'FGXOR',FGXor,white);
  109.    TestAllLines(300,100,'FXOR',FGXor,black);
  110.  
  111.    TestAllLines(400,0,'FGOR',FGOr,white);
  112.    TestAllLines(400,100,'FOR',FGOr,black);
  113.  
  114.    showmouse;
  115.    waitforkey;
  116.    hidemouse;
  117.  
  118.    cleardevice;
  119.  
  120.    fonttable := @font14;
  121.    testchars(70,0,white,FGNORM,'FGNORM');
  122.    testchars(70,teglcharheight+2,black,FGNORM,'FGNORM');
  123.  
  124.    testchars(70,2*(teglcharheight+2),white,FGAND,'FGAND');
  125.    testchars(70,3*(teglcharheight+2),black,FGAND,'FGAND');
  126.  
  127.    testchars(70,4*(teglcharheight+2),white,FGOR,'FGOR');
  128.    testchars(70,5*(teglcharheight+2),black,FGOR,'FGOR');
  129.  
  130.    testchars(70,6*(teglcharheight+2),white,FGXOR,'FGXOR');
  131.    testchars(70,7*(teglcharheight+2),black,FGXOR,'FGXOR');
  132.  
  133.    testchars(70,8*(teglcharheight+2),white,FGNOT,'FGNOT');
  134.    testchars(70,9*(teglcharheight+2),black,FGNOT,'FGNOT');
  135.  
  136.  
  137.    showmouse;
  138.    waitforkey;
  139. end.
  140.